home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / oasis.zip / SAMPLE4.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-24  |  10KB  |  279 lines
  1. PROGRAM Automenu;
  2. {$R-,I+,F-,B-,N-}
  3. {$M 12000,0,64000}
  4. {$V-}                {Disable STRING LENGTH Checks}
  5.  
  6. Uses printer,Dos,Crt,Scl;
  7.  
  8. VAR
  9.   Mypath,
  10.   Wrkstr:String80;
  11.   Action_To_Be_Described,  {these 3 boolean variables}
  12.   Progname_To_Be_Written,  {are used to control the}
  13.   Paramline_To_Be_Cleared, {backgroud tasks to be done}
  14.   First :BOOLEAN;
  15.   Count,
  16.   This_Entry,
  17.   Next_Entry,
  18.   Highest_Valid_Entry:INTEGER;
  19.   Dta                : Searchrec;
  20.  
  21.  
  22. PROCEDURE New_Field(VAR Old,NEW:INTEGER); {deselects old and}
  23. VAR                                       {selects new field.}
  24.   Progname:String13;
  25. BEGIN;
  26.   W_Sel(Old,FALSE);       {remove highlighting from old field}
  27.   W_Sel(NEW,TRUE);        {highlight new field}
  28.   Old:=NEW;               {new field is now the current one}
  29.   Action_To_Be_Described:=TRUE;      {schedule activities}
  30.   Progname_To_Be_Written:=TRUE;      {to be performed as a }
  31.   Paramline_To_Be_Cleared:=TRUE;     {background task as soon}
  32. END;                                 {as we find time...}
  33.  
  34. PROCEDURE Write_Action;             {called by user_slow_batch}
  35. VAR                                 {as a background task}
  36.   Progname:String13;                {does required update to}
  37. BEGIN;                              {field number 47}
  38.   Progname:=G_Cont(This_Entry);
  39.   IF POS('<DIR>',Progname) > 0 THEN
  40.     W_Cont(47,'Change Dir to')
  41.   ELSE
  42.     W_Cont(47,'Run Program');
  43.   Action_To_Be_Described:=FALSE;    {this batch job done...}
  44. END;
  45.  
  46.  
  47. PROCEDURE Write_Progname; {another low priority batch job}
  48. VAR                       {we only do if we have time to do it}
  49.   Progname:String13;      {It updates field 48 and is called}
  50. BEGIN;                    {by procedure user_slow_batch}
  51.   Progname:=G_Cont(This_Entry);
  52.   CASE POS('.',Progname) OF      {do the formatting..}
  53.     0:Progname:=Justify_Left(Progname,8); {must be subdirectory}
  54.     1:Progname:='<Parent Dir>'            {parent directory}
  55.     ELSE
  56.       Progname:=COPY(Progname,1,POS('.',Progname)-1); {program}
  57.   END;
  58.   W_Cont(48,Progname);           {write it to field 48}
  59.   Progname_To_Be_Written:=FALSE; {this batch job done..}
  60. END;
  61.  
  62. PROCEDURE Clear_Params;  {our third batch job. clears field 49,}
  63. BEGIN;                   {if there is something in it}
  64.   IF G_Cont(49) > ' ' THEN        {if there is something then..}
  65.     C_Cont(49);                   {..clear it.}
  66.   Paramline_To_Be_Cleared:=FALSE; {this batch job is done..}
  67. END;
  68.  
  69. (*$F+*)   (* Force Far Calls Option; Required FOR Background Tasks*)
  70. PROCEDURE Lp_Background_Task; {our background processing task}
  71. {for low priority batch jobs. We use it here to update the screen
  72.  whenever there is spare time to do it}
  73. BEGIN;
  74.   IF Progname_To_Be_Written THEN
  75.     Write_Progname                 {our three batch jobs}
  76.   ELSE                             {in sequence of their}
  77.   IF Paramline_To_Be_Cleared THEN  {priority.}
  78.     Clear_Params
  79.   ELSE
  80.   IF Action_To_Be_Described THEN
  81.     Write_Action;
  82. END;
  83. (*$F-*)   (* RESET Force Far Calls Option*)
  84.  
  85. PROCEDURE Scl_Defaults;
  86. BEGIN;
  87.   Auto_Help_Set:=FALSE;           {AutoHelp feature disabled}
  88.   Beep_Time:=1;                   {very short beep}
  89. END;
  90.  
  91. PROCEDURE Pick_It_If_We_Need_It; {we want to display all }
  92.                       {executable files plus all directory}
  93. VAR                   {entries except the one for the current}
  94.   Ext:String10;       {subdirectory, shown as a single dot}
  95.   Len:INTEGER;
  96.  
  97. PROCEDURE Pick_It;
  98. BEGIN;
  99.   W_Cont(Count,Wrkstr); {write the file name to the next field}
  100.   Count:=SUCC(Count);   {point to one field above}
  101. END;
  102.  
  103. BEGIN;
  104.   Wrkstr:=Dta.Name;
  105.   Ext:=COPY(Wrkstr,POS('.',Wrkstr)+1,3); {get the extension}
  106.   IF (Ext='BAT') OR (Ext='COM') OR (Ext='EXE') THEN
  107.     Pick_It                           {write it to our format}
  108.   ELSE
  109.     IF (Dta.Attr AND $10) = $10 THEN {subdirectory}
  110.       BEGIN;
  111.         IF (Wrkstr[1]<>'.') OR (POS('..',Wrkstr) <>0) THEN
  112.           BEGIN; {it is not a single dot ('this subdirectory')}
  113.             Wrkstr:=Justify_Left(Wrkstr,8)+'<DIR>';
  114.             Pick_It;   {mark it as a 'dir' entry and write it}
  115.           END;         {to our format as well}
  116.       END;
  117. END;
  118.  
  119. PROCEDURE Init_Dir_Search;
  120. BEGIN;
  121.   First:=TRUE;
  122.   Wrkstr:=Mypath+'*.*';
  123. END;
  124.  
  125. PROCEDURE Update_Mydir;
  126. BEGIN;
  127.   Getdir(0,Mypath);                  {current path to 'mypath'}
  128.   IF LENGTH(Mypath) > 3 THEN         {if it is not the root dir}
  129.     Mypath:=Mypath + '\';            {then add a backslash.}
  130. END;
  131.  
  132. PROCEDURE Notify_User;
  133. BEGIN;
  134.   TEXTCOLOR(Textattr+128);    {blink}
  135.   WRITELN('Press RETurn to go back to AMENU');
  136.   READLN; {maybe there is some info on the screen the }
  137. END;      {user wants to read before we clear it}
  138.  
  139.  
  140. PROCEDURE Display_Files; {get all files in the current directory}
  141. BEGIN;
  142.   W_Cont(1,Mypath);   {write the present path to field 1}
  143.   Count:=2;           {our filename entries start here}
  144.   REPEAT
  145.     IF First THEN
  146.       BEGIN;
  147.         Findfirst(Wrkstr,(Anyfile-(Hidden+Volumeid+Sysfile)),Dta);
  148.         First:=FALSE;
  149.       END
  150.     ELSE
  151.       Findnext(Dta);     {get a filename}
  152.     IF Doserror = 0 THEN        {we found one..}
  153.       Pick_It_If_We_Need_It
  154.     ELSE
  155.       Init_Dir_Search;     {for the next time}
  156.   UNTIL (Doserror>0) OR (Count>46); {no more files or format full}
  157.   Highest_Valid_Entry:=Count - 1; {no file names beyond there}
  158.   IF Count <= 46 THEN             {clear the remaining fields}
  159.     FOR Count:=Count TO 46 DO     {because they still might }
  160.       C_Cont(Count);       {contain something from last time}
  161.   Next_Entry:=2;           {the field we want to highlight}
  162.   New_Field(This_Entry,Next_Entry); {do it.}
  163. END;
  164.  
  165. PROCEDURE Handle_Key;    {user function key handling procedure}
  166. BEGIN;
  167.   IF Char_Code = Code_F9 THEN   {next page}
  168.     BEGIN;
  169.       W_Sel(This_Entry,FALSE);  {deselect currently highlighted}
  170.       Display_Files; {field and refill the format. 'first' }
  171.     END   {determines whether this is the first page or not}
  172.   ELSE
  173.   IF (Char_Code = Code_Right) THEN
  174.     Next_Entry:= This_Entry + 1 ELSE
  175.   IF (Char_Code = Code_Left)  THEN
  176.     Next_Entry:= This_Entry - 1 ELSE
  177.   IF (Char_Code = Code_Up)    THEN
  178.     Next_Entry:= This_Entry - 5 ELSE
  179.   IF (Char_Code = Code_Down)  THEN
  180.     Next_Entry:= This_Entry + 5 ELSE
  181.   IF (Char_Code = Code_Home)  THEN
  182.     Next_Entry:= 2             ELSE
  183.   IF (Char_Code = Code_End)   THEN
  184.     Next_Entry:= Highest_Valid_Entry;
  185.  
  186.   IF (Next_Entry > Highest_Valid_Entry) OR (Next_Entry < 2) THEN
  187.     Next_Entry:=This_Entry; {we stay where we are in these cases}
  188.  
  189.   IF Next_Entry <> This_Entry THEN {if we found a new field then}
  190.     New_Field(This_Entry,Next_Entry); {let's go there.}
  191.  
  192.   IF Char_Code = Code_Escape THEN   {we just want to act in the}
  193.     Char_Code:=Code_F10   {same way as if F10 was pressed}
  194.   ELSE
  195.   IF (Char_Code = Code_Return) THEN
  196.     Char_Code:=Code_Escape  {normally SCL would switch to edit}
  197.   ELSE           {mode now, but we want to save one keystroke.}
  198.     Char_Code:=Code_Noop; {SCL should not act on this character}
  199. END;
  200.  
  201. PROCEDURE Do_Work;
  202. VAR
  203.   T,
  204.   Newdir,
  205.   Progname:String80;
  206. BEGIN;
  207.   Progname:=G_Cont(This_Entry);          {the highlighted field}
  208.   IF POS('<DIR>',Progname) > 0 THEN      {if it is a directory}
  209.     BEGIN;
  210.       Frontstring(Progname,Newdir,T);
  211.       Chdir(Newdir);
  212.       Update_Mydir;
  213.     END
  214.   ELSE
  215.     BEGIN;
  216.       IF (POS('.BAT',Progname) > 0) THEN          {a batch file}
  217.         Executedos(Mypath+Progname+' '+G_Cont(49)) {then fire it}
  218.       ELSE                                   {up via 'DOS' else}
  219.         EXECUTE(Mypath+Progname+' '+G_Cont(49)); {Execute}
  220.       IF Doserror = 0 THEN       {we are successfully back}
  221.         Notify_User;
  222.       TEXTMODE(Screen_Mode);      {if we were in another mode}
  223.       CLRSCR;                     {blank the screen}
  224.     END;
  225. END;
  226.  
  227. PROCEDURE Tell_Result;
  228. VAR Wstr:STRING;
  229. BEGIN;
  230.   IF (Doserror > 0) AND (Doserror <> 18) THEN {we had a problem,
  231.                                               18=no more files}
  232.     BEGIN;
  233.       Wstr:=Sys_Msg(Doserror+20); {ErrMsg}
  234.       Beep;                       {wake up user}
  235.     END
  236.   ELSE
  237.     BEGIN;
  238.       CASE Dosexitcode OF
  239.           0 : Wstr:= 'Operation was successful';
  240.           1 : Wstr:= 'Program was terminated by Ctrl_C';
  241.           2 : Wstr:= 'Program was terminated due to a device error';
  242.           3 : Wstr:= 'Program was terminated and kept resident';
  243.       END;
  244.     END;
  245.   W_Cont(50,Wstr);
  246. END;
  247.  
  248.  
  249. PROCEDURE Menu;
  250. BEGIN;
  251.   Select_Format('amenu');           {load format into heap}
  252.   Init_Dir_Search;
  253.   This_Entry:=2;
  254.   Display_Files;        {fill fields 2..46 with file names}
  255.   Tell_Result;    {result from our last execute to field 50}
  256.   Display_Format(X_Max DIV 2,Y_Max DIV 2);  {center of screen}
  257.   REPEAT
  258.     Handle_Format;
  259.     IF User_Function THEN    {one of the specified keys pressed}
  260.       Handle_Key;            {handle it.}
  261.   UNTIL Format_Done;
  262.   IF NOT Format_Aborted THEN  {if normal termination}
  263.     Do_Work;
  264. END;
  265.  
  266. BEGIN; {of main}
  267.   Select_Format_File('Sample4');   {initializes SCL and loads the format
  268.                                    {file 'Sample4'}
  269.   Scl_Defaults;                    {change some SCL defaults}
  270.   Lp_Background_Pointer:=@lp_Background_Task; (*invoke our own background
  271.                                                 processing routine*)
  272.   Update_Mydir;
  273.  
  274.   REPEAT
  275.     Menu                           {main loop}
  276.   UNTIL Format_Aborted;            {'F10' key was pressed }
  277.   Close_Formats;                   {terminate SCL}
  278. END.  {of main}
  279.